home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / SystemCode / think.tcl < prev    next >
Encoding:
Text File  |  1994-09-11  |  7.7 KB  |  307 lines  |  [TEXT/ALFA]
  1. # The following flags affect Think's "Run" command.
  2. # THINK will crash if you set the debugger flag and your 
  3. # project does not have debugging information. 
  4. if {![info exists thinkdebugger]}     {set thinkdebugger     0}
  5. if {![info exists thinkgo]}         {set thinkgo         1}
  6. if {![info exists thinksaveDirty]}     {set thinksaveDirty    1}
  7. if {![info exists thinkupdate]}     {set thinkupdate     1}
  8.  
  9. menu -n thinkFlags -p thinkFlagsProc {"debugger" "go" "saveDirty" "update"}
  10. markMenuItem thinkFlags debugger     $thinkdebugger
  11. markMenuItem thinkFlags go             $thinkgo
  12. markMenuItem thinkFlags saveDirty    $thinksaveDirty
  13. markMenuItem thinkFlags update         $thinkupdate
  14.  
  15. proc thinkFlagsProc {menu item} {
  16.     global think$item modifiedVars
  17.     
  18.     set think$item [expr -1 * ([set think$item] - 1)]
  19.     markMenuItem thinkFlags $item [set think$item]
  20.     lappend modifiedVars think$item
  21. }
  22.  
  23. set THINK "THINK Project Manager"
  24. #set THINK "AEvent Display 1.3"
  25.  
  26.  
  27. proc thinkNumFiles {} {
  28.     global THINK
  29.     set str [AEBuild -r $THINK "core" "cnte" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('SFIL')"]
  30.     if {[regexp {[0-9]+} $str mtch]} {
  31.         return $mtch
  32.     } else {
  33.         error "Bad numfiles"
  34.     }
  35. }
  36.  
  37.  
  38.  
  39. # Get list of files in current project.
  40. proc projectFileList args {
  41.     watchCursor
  42.     checkRunning ThinkC KAHL thinkName
  43.     set num [thinkNumFiles]
  44.     set files {}
  45.  
  46.     for {set i 1} {$i<=$num} {incr i} {
  47.         set f [thinkFileName $i]
  48.         set l [ls -l $f]
  49.         if {[lindex $l 7] == "TEXT"} {
  50.             lappend files $f
  51.         }
  52.     }
  53.  
  54.     return $files
  55. }
  56.  
  57.  
  58.  
  59.  
  60. #================================================================================
  61.  
  62.  
  63. proc think {} {
  64.     set name [checkRunning ThinkC KAHL thinkName]
  65.     if {![string length $name]} return
  66.     switchTo $name
  67. }
  68.  
  69. proc searchNextFile {} {
  70.     thinkFinf
  71. }
  72.  
  73.  
  74.  
  75. #===========================================================================
  76. # Add fileset.
  77. #===========================================================================
  78. proc createThinkFileset {} {
  79.     global fileSets
  80.     global currFileSet
  81.     
  82.     set name [prompt "Fileset name? " "THINK"]
  83.     set fileSets($name) [projectFileList]
  84.     addMenuItem -m choose $name
  85.     set currFileSet $name
  86.  
  87.     if {[askyesno "Save project fileset?"] == "yes"} {
  88.         addUserLine "set \"fileSets($name)\" \{$fileSets($name)\}"
  89.     }
  90.     makeFilesetMenu
  91. }
  92.  
  93. #================================================================================
  94.  
  95. proc compile {} {
  96.     sendCompileEvent CMPL "-r"
  97. }
  98.  
  99. proc checkSyntax {} {
  100.     sendCompileEvent SNTX "-q"
  101. }
  102.  
  103. proc disassemble {} {
  104.     global THINK ALPHA
  105.     set tname [checkRunning ThinkC KAHL thinkName]
  106.     set name [lindex [winNames -f] 0]
  107.     switchTo $tname
  108.     set res [AEBuild -t 7200 -r $tname KAHL DASM CFLG long(32) "----" [fileObject $name]]
  109.     switchTo $ALPHA
  110.     new -n "* [file root [file tail $name]].asm *"
  111.     regexp {“.*”} $res text
  112.     insertText [string trim $text {“”}]
  113.     setWinInfo dirty 0
  114.     goto 0
  115. }
  116.  
  117. proc preprocess {} {
  118.     global THINK ALPHA
  119.     set tname [checkRunning ThinkC KAHL thinkName]
  120.     set name [lindex [winNames -f] 0]
  121.     switchTo $tname
  122.     set res [AEBuild -r $tname KAHL PRCS CFLG long(32) "----" [fileObject $name]]
  123.     switchTo $ALPHA
  124.     new -n "* Preprocessed '[file tail $name]' *"
  125.     regexp {“.*”} $res text
  126.     insertText [string trim $text {“”}]
  127. }
  128.  
  129.  
  130. proc sendCompileEvent {event arg} {
  131.     global THINK ALPHA
  132.     set tname [checkRunning ThinkC KAHL thinkName]
  133.     set name [lindex [winNames -f] 0]
  134.     switchTo $tname
  135.     if {[string length $arg]} {
  136.         set res [AEBuild -t 7200 $arg $tname KAHL  $event "----" [fileObject $name]]
  137.     } else {
  138.         set res [AEBuild -t 7200 $tname KAHL  $event "----" [fileObject $name]]
  139.     }
  140.     switchTo $ALPHA
  141.     return $res
  142. }
  143.  
  144.  
  145. proc add {} {
  146.     global THINK
  147.     set fname [lindex [winNames -f] 0]
  148.     AEBuild $THINK core crel "data" [makeAlis $fname] "kocl" "type('SFIL')"
  149. }
  150.  
  151. proc addAndCompile {} {
  152.     add
  153.     compile
  154. }
  155.  
  156.  
  157. proc precompile {} {
  158.     sendCompileEvent PCMP ""
  159. }
  160.  
  161. proc bringUpToDate {} {
  162.     global THINK ALPHA
  163.     set name [checkRunning ThinkC KAHL thinkName]
  164.     switchTo $name
  165.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  166.     switchTo $ALPHA
  167.     return $res
  168. }
  169.  
  170. proc make {} {
  171.     global THINK ALPHA
  172.     set name [checkRunning ThinkC KAHL thinkName]
  173.     switchTo $name
  174.     set res [AEBuild -q $name KAHL CMPL SLCT MAKE "CFLG" "long(2)" "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}}] 
  175. }
  176.  
  177. proc run {} {
  178.     global THINK thinkdebugger thinkgo thinksaveDirty thinkupdate
  179.     
  180.     set name [checkRunning ThinkC KAHL thinkName]
  181.     set dbug [expr {$thinkdebugger ? "bool(«01»)" : "bool(«00»)"}]
  182.     set go [expr {$thinkgo ? "bool(«01»)" : "bool(«00»)"}]
  183.     set update [expr {$thinkupdate ? "'yes '" : "'no  '"}]
  184.     set dirty [expr {$thinksaveDirty ? "'yes '" : "'no  '"}]
  185.     switchTo $name
  186.     AEBuild -q $name KAHL "RUN " "DBUG" $dbug  "GO  " $go "UPDT" $update "savo" $dirty
  187. }
  188.  
  189. proc debug {} {
  190.     global THINK 
  191.     set fname [lindex [winNames -f] 0]
  192.     set row [expr [lindex [posToRowCol [getPos]] 0] - 1]
  193.     set res [AEBuild $THINK KAHL DBGF "----" [makeAlis $fname] LNNO "short($row)" ]
  194. }
  195.  
  196. proc cnt {} {
  197.     global THINK
  198.     AEBuild -t 6000 -r $THINK core cnte "----" {obj{want:type('PDOC'), from:'null'(), form:'indx', seld:1}} "kocl" "type('sfil')"
  199. }
  200.  
  201. proc thinkFileName {arg} {
  202.     global THINK
  203.     set event [join [concat {obj\ \{want:type('prop'),\ from:obj\ \{want:type('SFIL'),\ from:'null'(),\ form:'indx',\ seld:} $arg {\},\ form:'prop',\ seld:type('FSS\ ')\}}] ""]
  204.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  205.     regexp {«.*»} $blah blah
  206.     return [specToPathName [string trim $blah {«»}]]
  207. }
  208.  
  209. proc thinkInclude {name} {
  210.     global THINK thinkpaths
  211.     if {[info exists thinkpaths]} {unset thinkpaths}
  212.     set event [join [concat {obj\ \{want:type('prop'),\ from:obj\ \{want:type('SFIL'),\ from:'null'(),\ form:'name', seld:“} [file tail $name] {”\},\ form:'prop',\ seld:type('INCL')\}}] ""]
  213.     set blah [AEBuild -r $THINK "core" "getd"  "----" $event]
  214.     if {![regexp {«} $blah]} {return {{(No includes}}}
  215.     regsub -all {»[^«]*«} $blah { } raw
  216.     regsub {[^«]*«} $raw {} raw
  217.     regsub {».*} $raw {} raw
  218.     foreach f $raw {
  219.         set path [specToPathName $f]
  220.         set tl [file tail $path]
  221.         set thinkpaths($tl) $path
  222.         lappend names $tl
  223.     }
  224.     return [lsort -ignore $names]
  225. }
  226.  
  227. # Called by Alpha to get list of include files for popup.
  228. proc thinkIncludeFiles {} {
  229.     if {[catch {thinkInclude [lindex [winNames] 0]} ret]} {
  230.         return {{(* THINK not running *}}
  231.     }
  232.     return $ret
  233. }
  234.  
  235. # Called by Alpha to edit result of popup
  236. proc thinkEditFile {name} {
  237.     global thinkpaths
  238.     
  239.     edit $thinkpaths($name)
  240. }
  241.  
  242. proc openHeader {} {
  243.     global thinkpaths
  244.  
  245.     set name [lindex [winNames] 0]
  246.     if {![string length $name]} return
  247.     if {[catch {thinkInclude $name} names]} {
  248.         message "Think not running!" 
  249.         beep
  250.         return
  251.     }
  252.     if {![string length $name] || [string match {(*} [lindex $names 0]]} {
  253.         message "No headers."
  254.         beep
  255.         return
  256.     }
  257.     set res [listpick -p {Include File?} $names]
  258.     if {[string length $res]} {edit $thinkpaths($res)}
  259. }
  260.         
  261.  
  262. proc removeDups {l} {
  263.     foreach f $l {
  264.         set silly($f) 1
  265.     }
  266.     if {[info exists silly]} {
  267.         return [array names silly]
  268.     }
  269. }
  270.             
  271. #================================================================================
  272.         
  273. proc handleThinkReply { l } {
  274.     global thinkErrors teIndex ALPHA tileHeight winModes terrMenu
  275.     set thinkErrors $l
  276.     switchTo $ALPHA
  277.     set teIndex 0
  278.     
  279.     global defHeight defLeft defTop defWidth
  280.     set sl $defLeft
  281.     set st $defTop
  282.     set sh $defHeight
  283.     set sw $defWidth
  284.     set defHeight 140
  285.     set defWidth 510
  286.     set defLeft 3
  287.     set defTop 40
  288.  
  289.     foreach err $l {
  290.         append lines "\"[file tail [lindex $err 0]]\"; " [format "Line %d: " [lindex $err 2]] [lindex $err 1] "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞[lindex $err 0]∞[lindex $err 1]\r"
  291.     }
  292.  
  293.     new
  294.     set defLeft $sl
  295.     set defTop $st
  296.     set defHeight $sh
  297.     set defWidth $sw
  298.  
  299.     insertText "(<cr> to go to error)\r-----\r" $lines
  300.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  301.     
  302.     global winModes
  303.     set name [lindex [winNames] 0]
  304.     changeMode [set winModes($name) Brws]
  305. }
  306.  
  307.